home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / LIB211.ZIP;1 / LISTFILE.PRG < prev    next >
Encoding:
Text File  |  1993-11-19  |  28.6 KB  |  697 lines
  1. PROCEDURE ListFile
  2. *-----------------------------------------------------------------------
  3. *-- Program.....: LISTFILE.PRG
  4. *-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
  5. *-- Date........: 07/28/1993
  6. *-- Notes.......: This program/set of routines is designed to display an
  7. *--               ASCII file of up to 1,170 lines, and 254 characters 
  8. *--               per line on the screen. 
  9. *--               ** WARNING ** in dBASE IV, 1.5 -- if you get close to
  10. *--               the 1,170 line limit, you will run out of memory.
  11. *--               (If using version 2.0 or greater, you may be able to 
  12. *--                read in 10,000 lines ... the array capabilities 
  13. *--                allow up to 64K lines (65,535 elements), but I 
  14. *--                figured that 10000 was pretty huge ...)
  15. *--               It allows scrolling (up,down,left,right), and a few 
  16. *--               hot-keys as well:
  17. *--                 <Home>        = the beginning/first character of 
  18. *--                                 the line
  19. *--                 <End>         = the right side of a line
  20. *--                 <Ctrl><Home>  = the top of the file
  21. *--                 <Ctrl><End>   = the bottom of the file 
  22. *--                 <PgUp>/<PgDn> = page up/down one screen at a time 
  23. *--                 <Esc>/<Enter> = exit
  24. *--                 <S> or <s>    = Search (text search from location to
  25. *--                                  end)
  26. *--                 <F1>          = HELP
  27. *-- Rev. History: 01/25/1993 -- Original Release
  28. *--               02/24/1993 -- Minor modifications -- if user sends # 
  29. *--                             of lines that would give a window larger
  30. *--                             than the screen can handle (nMaxLines + 
  31. *--                             nRow > length of screen), we set the max
  32. *--                             number of lines to the length of the 
  33. *--                             screen. Also Added <Enter> to exit 
  34. *--                             routine.
  35. *--               03/11/1993 -- Minor change for version 2.0 -- allows 
  36. *--                             up to 10,000 lines ... no guarantees on
  37. *--                             whether or not you will run out of 
  38. *--                             memory.
  39. *--               04/29/1993 -- Added HELP on F1
  40. *--                             Added a "Search" feature.
  41. *--                             Minor difference in how colors are used.
  42. *-- Usage.......: DO ListFile WITH <cFileName>,<nRow>[,<nMaxLines>[,;
  43. *--                                <nTab>[,<cColor>]]]
  44. *-- Example.....: do listfile with "ListFile.PRG",5,18,3,"rg+/g"
  45. *-- Parameters..: cFileName = name of file to list -- include extension 
  46. *--                           and path if necessary
  47. *--               nRow      = starting row on screen (top of "window")
  48. *--               nMaxLines = optional -- number of lines to display at 
  49. *--                           one time -- if left off, routine will use 
  50. *--                           as many lines as possible from nRow to 
  51. *--                           bottom of screen. 
  52. *--               nTab      = optional -- number of spaces to use for 
  53. *--                           tab characters at the beginning of a line.
  54. *--                           Ignores tabs after the first non-tab 
  55. *--                           character in a line for speed's sake.
  56. *--               cColor    = optional -- provide color description for
  57. *--                           window, format: Foreground/Background. 
  58. *--                           For example, to display the file in a 
  59. *--                           window that has yellow text on a green 
  60. *--                           background, the parameter would be:
  61. *--                           "rg+/g"
  62. *--                           The second colors provided will be used
  63. *--                           for HELP and dialog box colors. I.e.,
  64. *--                           a color string: "rg+/g,w+/b", the second 
  65. *--                           pair of colors will be used for help and
  66. *--                           such.
  67. *--                            If no colors are provided, the main 
  68. *--                           screen will be the current colors 
  69. *--                           (SET COLOR TO), and the help and other 
  70. *--                           colors will be the highlight colors 
  71. *--                           (set color of ...) from the attribute
  72. *--                           string.
  73. *-----------------------------------------------------------------------
  74.  
  75.    parameters cFileName,nRow,nMaxLines,nTab,cColor
  76.    private cWindow,cCursor,nDisplay,nBottom,nLastLine,x,nCount,;
  77.            nKey,nFirstLine,nCurrPos,cSearch
  78.          
  79.    *-- cSearch is initialized here, but we want to save the current
  80.    *-- value of it, so that if a search is performed, and the user
  81.    *-- wants to do another search later on the same criteria, 
  82.    *-- they can ... (search for next occurance?)
  83.    m->cSearch = space(20)       && Search criteria
  84.    m->lCase   = .f.             && case sensitive search?
  85.    
  86.    *-- screen handling
  87.    save screen to sListFile  && save screen description
  88.    m->cWindow = window()     && store name of any "current" window
  89.                              && on screen
  90.    m->cCursor = set("CURSOR") && save current cursor state
  91.    set cursor off            && turn it off ...
  92.    activate screen           && activate screen so we can display 
  93.                              && on TOP of anything there.
  94.    if pCount() > 4           && if user gave us a set of colors to 
  95.                              && use
  96.       m->cNewColor = "COLOR "+m->cColor  && define memvar with the 
  97.                                          && word "COLOR" in it
  98.     else
  99.       m->cTemp = set("ATTRIBUTE")
  100.       m->cNorm = colorbrk(m->cTemp,1)
  101.       m->cHigh = colorbrk(m->cTemp,2)
  102.       m->cColor = m->cNorm+","+m->cHigh
  103.       m->cNewColor = "COLOR " + m->cColor && otherwise, set 
  104.                                           && to system default
  105.    endif
  106.    
  107.    *-- if user gave a value for nMaxLines, and it's too big, we 
  108.    *-- have set nMaxLines to bottom of screen.
  109.    if pCount() => 3  && we have a parameter passed for this
  110.       if set("DISPLAY") # "MONO" .and. set("DISPLAY") # "COLOR"
  111.          m->nDisplay = val(right(set("DISPLAY"),2))
  112.          if (m->nMaxLines + m->nRow) => m->nDisplay
  113.              m->nMaxLines = (m->nDisplay - 1) - m->nRow   
  114.                               && if nDisplay gives 25,
  115.                               && set to 24, as the screen
  116.                               && goes from 0 to 24 ...
  117.          endif
  118.       else
  119.          if (m->nMaxLines + m->nRow) > 24
  120.              m->nMaxLines = 24 - m->nRow
  121.          endif
  122.       endif
  123.    endif
  124.    
  125.    *-- if user didn't tell us how many lines to display ...
  126.    if pCount() = 2 && determine # of lines to display on screen ...
  127.       *-- find bottom of screen, and then subtract nRow from that ...
  128.       if set("DISPLAY") # "MONO" .and. set("DISPLAY") # "COLOR"
  129.          && if we have such displays as EGA25, or VGA50 ...
  130.          m->nDisplay = val(right(set("DISPLAY"),2))  
  131.                                     && get the value of the right
  132.       else                          && two characters
  133.          m->nDisplay = 25           && if MONO/COLOR, we have 25 
  134.                                     && lines possible
  135.       endif
  136.       if set("STATUS") = "ON"       && if status line is on, we 
  137.                                     && have four less
  138.                                     && lines to work with
  139.          m->nDisplay = m->nDisplay - 4
  140.       endif
  141.       m->nMaxLines = (m->nDisplay - 1) - m->nRow  
  142.                 && nDisplay - 1 is so we don't
  143.                 && go beyond last line (EGA25 
  144.                 && gives 25, but last line is 
  145.                 && number 24!)
  146.    endif
  147.    
  148.    *-- bottom row of window is based on m->nMaxLines
  149.    m->nBottom = m->nRow + m->nMaxLines
  150.    
  151.    *-- set default tab if needed ...
  152.    if pCount() < 4       && set default ... notice that if it's 0, 
  153.                          && that's not 'undefined'
  154.       m->nTab = 5
  155.    endif
  156.    
  157.    *-- get the number of lines in the text file
  158.    m->nLastLine = TextLine(m->cFileName)   && obtain line number of
  159.                                            && last line of file
  160.    m->nVersion  = val(right(version(),3))  && get version #
  161.    if m->nVersion < 2.0                    && if less 2.0
  162.       if m->nLastLine > 1170               && max lines we can 
  163.                                       && read into array
  164.             m->nLastLine = 1170             &&  is 1,170
  165.        endif
  166.      else                                  && we have version 2.0
  167.                                            &&  or greater
  168.        if m->nLastLine > 10000             &&  we can display 
  169.                                       && 10,000 lines
  170.           m->nLastLine = 10000
  171.        endif
  172.    endif
  173.    
  174.    *-- display a message for user to let them know we haven't just
  175.    *-- disappeared ...
  176.    do shadow with 10,26,13,52
  177.    m->cBoxColor = colorbrk(m->cColor,2)
  178.    @10,26 to 13,52 double color &cBoxColor.
  179.    @11,27 say " Reading/Processing File " color &cBoxColor.
  180.    m->cLines = space(7)+transform(m->nLastLine,"99999")+;
  181.                " Lines"+space(7)
  182.    @12,27 say m->cLines color &cBoxColor.
  183.    
  184.    *-- get it
  185.    m->x = AAppend(m->cFileName,"aFileList")  && put file into array
  186.    
  187.    *-- deal with tabs here
  188.    if m->nTab # 0
  189.       m->nCount = 1
  190.       do while m->nCount < m->nLastLine
  191.          do while chr(9) $ aFileList[m->nCount]   && loop while 
  192.                                              && there is a tab
  193.                                         && in the line
  194.             aFileList[m->nCount] = ;
  195.               stuff(aFileList[m->nCount],at(chr(9),;
  196.               aFileList[m->nCount]),1,;
  197.               space(m->nTab))
  198.          enddo
  199.          m->nCount = m->nCount + 1
  200.       enddo
  201.    endif
  202.    
  203.    *-- loop and pad each array element with spaces to 254 
  204.    *-- characters
  205.    m->nCount = 1
  206.    do while m->nCount < m->nLastLine
  207.       aFileList[m->nCount] = aFileList[m->nCount]+;
  208.                    space(254-len(aFileList[m->nCount]))
  209.       m->nCount = m->nCount + 1
  210.    enddo
  211.    
  212.    *-- remove message
  213.    restore screen from sListFile
  214.    
  215.    *-- define window
  216.    define window wListFile from m->nRow,0 to m->nBottom,79 ;
  217.                                            none &cNewColor.
  218.    activate window wListFile
  219.    
  220.    *-- now that we're here, let's go ...
  221.    m->nKey = 0         && initialize to something we're not 
  222.                         && looking for
  223.    m->nFirstLine = 1   && First line to display out of list ...
  224.    m->nCurrPos   = 1   && current position in string
  225.    
  226.    *-----------------------------
  227.    *-- here's the actual loop ...
  228.    *-----------------------------
  229.    do while m->nKey # 27 .and. m->nKey # 13  
  230.                         && must press <Esc> or <Enter> to exit
  231.       
  232.       *-- display loop
  233.       m->nCounter = 0
  234.       do while m->nCounter < m->nMaxLines
  235.       
  236.          @m->nCounter,0 say substr(aFileList[m->nFirstLine+;
  237.                                 m->nCounter],m->nCurrPos,80)
  238.          m->nCounter = m->nCounter + 1
  239.       
  240.       enddo
  241.       
  242.       *-- get keypress
  243.       m->nKey = inkey(0)   && wait for a keypress
  244.       
  245.       *-- if keypress is one of the following, do something 
  246.       *-- with it ...
  247.       do case
  248.          case m->nKey = 5    && up arrow  = up one row
  249.             if m->nFirstLine > 1
  250.                m->nFirstLine = m->nFirstLine - 1
  251.             endif
  252.          case m->nKey = 24   && down arrow = down one row
  253.             if m->nFirstLine+m->nMaxLines < m->nLastLine
  254.                m->nFirstLine = m->nFirstLine + 1
  255.             endif
  256.          case m->nKey = 3    && <PgDn>  = down one screen
  257.             if m->nFirstLine+m->nMaxLines < ;
  258.                         (m->nLastLine - m->nMaxLines)
  259.                m->nFirstLine = m->nFirstLine + m->nMaxLines
  260.             else
  261.                m->nFirstLine = m->nLastLine - m->nMaxLines
  262.             endif
  263.          case m->nKey = 18   && <PgUp>  = up one screen
  264.             if m->nFirstLine - m->nMaxLines > 1
  265.                m->nFirstLine = m->nFirstLine - m->nMaxLines
  266.             else
  267.                m->nFirstLine = 1
  268.             endif
  269.          case m->nKey = 23   && <Ctrl><End>   = End of File
  270.             m->nFirstLine = m->nLastLine - m->nMaxLines
  271.          case m->nKey = 29   && <Ctrl><Home>  = Beginning of File
  272.             m->nFirstLine = 1
  273.          case m->nKey = 19   && <Left> = Back up one character
  274.             if m->nCurrPos > 1
  275.                m->nCurrPos = m->nCurrPos - 1
  276.             endif
  277.          case m->nKey = 4    && <Right> = Go RIGHT one character
  278.             if m->nCurrPos < 174  && 254-80 (width of string - 
  279.                                   && screen width
  280.                m->nCurrPos = m->nCurrPos + 1
  281.             endif
  282.          case m->nKey = 2    && <End> = end of line
  283.             m->nCurrPos = 174   && show last character(s) on right side 
  284.                                 && of text
  285.          case m->nKey = 26   && <Home> = beginning of line
  286.             m->nCurrPos = 1
  287.          case m->nKey = 28   && <F1> -- HELP routine
  288.             do showhelp
  289.          case m->nKey = 83 .or. m->nKey = 115 && "S" or "s"
  290.             do searcher
  291.       endcase
  292.       
  293.    enddo
  294.    
  295.    *-- if here, we <Esc>aped out of the loop
  296.    release window wListFile
  297.    restore screen from sListFile
  298.    release screen sListFile
  299.    if .not. isblank(m->cWindow)
  300.       activate window &cWindow.
  301.    endif
  302.    release aFileList
  303.    set cursor &cCursor.
  304.    
  305. RETURN
  306. *-- EoP: ListFile
  307.  
  308. *-----------------------------------------------------------------------
  309. *-- These next two routines were written FOR this program
  310. *-----------------------------------------------------------------------
  311.  
  312. PROCEDURE ShowHelp
  313. *-----------------------------------------------------------------------
  314. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  315. *-- Date........: 04/29/1993
  316. *-- Notes.......: A simple help routine for LISTFILE.PRG
  317. *-- Written for.: dBASE IV, 2.0
  318. *-- Rev. History: 04/29/1993
  319. *-- Calls.......: Shadow
  320. *-- Called by...: LISTFILE.PRG
  321. *-- Usage.......: do ShowHelp
  322. *-- Example.....: do ShowHelp
  323. *-- Returns.....: None
  324. *-- Parameters..: None
  325. *-----------------------------------------------------------------------
  326.  
  327.    *-- process colors
  328.    m->cForgCol = colorbrk(m->cColor,2)
  329.    m->cBackCol = colorbrk(m->cColor,1)
  330.    m->cHColor = m->cForgCol+","+m->cBackCol+","+m->cForgCol
  331.  
  332.    *-- deal with saving screen and defining window
  333.    save screen to sHelp
  334.    activate screen
  335.    define window wHelp from 6,8 to 18,72 double color &cHColor.
  336.    do shadow with 6,8,18,72
  337.    activate window wHelp
  338.  
  339.    *-- display help information
  340.    @0,28 say "H E L P"
  341.    @2, 2 say "<Home>        = The beginning/first character of "+;
  342.                              "the line"
  343.    @3, 2 say "<End>         = The right side of a line"
  344.    @4, 2 say "<Ctrl><Home>  = The top of the file"
  345.    @5, 2 say "<Ctrl><End>   = The bottom of the file"
  346.    @6, 2 say "<PgUp>/<PgDn> = Page Up/Down one screen at a time"
  347.    @7, 2 say "<Esc>/<Enter> = Exit"
  348.    @8, 2 say "<S> or <s>    = Search for text from current line "+;
  349.                               "to end"
  350.    @10, 2 say "           ... Press any key when ready ..."
  351.  
  352.    *-- wait for user to press a key
  353.    m->x=inkey(0)   
  354.  
  355.    *-- clean up
  356.    release window wHelp
  357.    restore screen from sHelp
  358.    release screen sHelp
  359.    activate window wListFile
  360.  
  361. RETURN
  362. *-- EoP: ShowHelp
  363.  
  364. PROCEDURE Searcher
  365. *-----------------------------------------------------------------------
  366. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  367. *-- Date........: 04/29/93
  368. *-- Notes.......: Search the array used in LISTFILE.PRG. Asks user in a
  369. *--               simple dialog box what to search for, and whether or 
  370. *--               not to perform the search as case sensitive.
  371. *-- Written for.: dBASE IV, 2.0
  372. *-- Rev. History: 04/29/93 -- Original
  373. *-- Calls.......: Shadow
  374. *-- Called by...: LISTFILE.PRG
  375. *-- Usage.......: Do Searcher
  376. *-- Example.....: Do Searcher
  377. *-- Returns.....: None
  378. *-- Parameters..: None
  379. *-----------------------------------------------------------------------
  380.  
  381.     *-- get colors
  382.     m->cForgCol = colorbrk(m->cColor,2)
  383.     m->cBackCol = colorbrk(m->cColor,1)
  384.     m->cSColor = m->cForgCol+","+m->cBackCol+","+m->cForgCol
  385.  
  386.     *-- deal with screen/window
  387.     save screen to sSearch
  388.     activate screen
  389.     define window wSearch from 10,22 to 13,59 double color &cSColor.
  390.     do shadow with 10,22,13,59   
  391.  
  392.     *-- cSearch is initialized at the beginning of LISTFILE, and not
  393.     *-- changed after the "first" search, unless the user changes it.
  394.     *-- the same goes for lCase ...
  395.     m->cSearch = m->cSearch+space(20-len(m->cSearch)) && pad back out 
  396.                                                      && to 20 characters
  397.  
  398.     *-- start 'er up
  399.     activate window wSearch
  400.     set curs on
  401.     @0,2 say "Search for: " get m->cSearch  && 20 characters
  402.     @1,2 say "Case Sensitive? " get m->lCase picture "Y"
  403.     read
  404.  
  405.     *-- if empty search string or <Esc> was pressed ...
  406.     if isblank(m->cSearch) .or. lastkey() = 27
  407.        release window wSearch
  408.        restore screen from sSearch
  409.        release screen sSearch
  410.        RETURN
  411.     endif
  412.  
  413.     *-- do it ...
  414.     set curs off           
  415.     m->cSearch = trim(m->cSearch) && remove extra spaces
  416.     m->nCount = m->nFirstLine     && start at the current position in 
  417.                                   && array
  418.     m->lFound = .f.
  419.     if .not. m->lCase  && not case sensitive, convert to caps and search
  420.        m->cSearchIt = upper(m->cSearch)
  421.        do while m->nCount < m->nLastLine     && from current line to end
  422.           if m->cSearchIt $ upper(aFileList[m->nCount])  
  423.                                                   && if a match is found
  424.              m->lFound = .t.                      && set memvar
  425.              exit                                 && exit loop
  426.           endif
  427.           m->nCount = m->nCount + 1
  428.         enddo
  429.      else
  430.         do while m->nCount < m->nLastLine
  431.            if m->cSearch $ aFileList[m->nCount]
  432.               m->lFound = .t.
  433.               exit
  434.            endif
  435.            m->nCount = m->nCount + 1
  436.         enddo
  437.      endif
  438.    
  439.      *-- put this line at top of screen, or near it
  440.      if m->lFound
  441.         m->nFirstLine = m->nCount
  442.         *-- some of the same logic as a <PgDn> (sort of)
  443.         if m->nFirstLine+m->nMaxLines => (m->nLastLine - m->nMaxLines)
  444.            m->nFirstLine = m->nLastLine - m->nMaxLines
  445.         endif
  446.      else
  447.         @1,0 clear
  448.         @1,2 say "** No Match Found **"
  449.         m->x=inkey(0)
  450.      endif
  451.  
  452.      *-- cleanup
  453.      release window wSearch
  454.      restore screen from sSearch
  455.      release screen sSearch
  456.      activate window wListFile
  457.  
  458. RETURN
  459. *-- EoP: Searcher
  460.  
  461. *-----------------------------------------------------------------------
  462. *-- The rest of the functions below are from the dUFLP library 
  463. *-- (available on Compuserve and the USSBBS), and are freeware. They are
  464. *-- used in the main program and/or in the two routines above ... A 
  465. *-- couple of them have been modified specifically for this routine. 
  466. *-- If you want the originals, look in the appropriate files in the 
  467. *-- dUFLP library (GO CIS:DBASE or GO PCM:TIPS).
  468. *-----------------------------------------------------------------------
  469.  
  470. FUNCTION AAppend
  471. *-----------------------------------------------------------------------
  472. *-- Programmer..: Adam L. Menkes (Borland Technical Support)
  473. *-- Date........: 03/11/1993
  474. *-- Notes.......: Appends a text file into an array. This routine is 
  475. *--               limited to text files of 1,170 lines, and 254 
  476. *--               characters per line. (Modified by KJM for this routine
  477. *--               only to handle up to 10000 lines for version 2.0 of 
  478. *--               dBASE IV) The text file must be an ASCII Txt formatted
  479. *--               file. Taken from Technotes, April, 1992.
  480. *-- Written for.: dBASE IV, 1.5
  481. *-- Rev. History: 04/01/1992 -- Original Release
  482. *--               02/24/1993 -- Modified to deal with nLines possibly 
  483. *--                             larger than 1170 -- if so, we blow up.
  484. *--                             This has been fixed.
  485. *--               03/11/1993 -- Version 2.0 of dBASE IV allows up to 64K 
  486. *--                             for an array, but I cut it off at 10,000
  487. *-- Calls.......: TextLine()           Function in LOWLEVEL.PRG
  488. *-- Called by...: Any
  489. *-- Usage.......: AAppend(<cFileName>,<aArrayName>)
  490. *-- Example.....: ?AAppend("CONFIG.DB","aConfig")
  491. *-- Returns.....: .T.
  492. *-- Parameters..: cFileName  = Name of DOS Text file to read into array
  493. *--               aArrayName = Name of array to create. If it already 
  494. *--                            exists, this array will be destroyed and 
  495. *--                            overwritten.
  496. *-----------------------------------------------------------------------
  497.  
  498.    parameters cFileName, aArrayName
  499.    private aTArray, nLines, nX, nHandle
  500.  
  501.    *-- assign array name to a temp variable name ...
  502.    aTArray = aArrayName
  503.    *-- if it exists, get rid of it, and then re-define it
  504.    release &aTArray.
  505.    public  &aTArray.
  506.    m->nLines = TextLine(m->cFileName)  && get number of lines
  507.    if val(right(version(0),3)) < 2     && version 2.0 or less
  508.       if m->nLines > 1170
  509.          m->nLines = 1170
  510.       endif
  511.    else
  512.       if m->nLines > 10000
  513.          m->nLines = 10000
  514.       endif
  515.    endif
  516.    declare &aTArray.[min(m->nLines,10000)]
  517.  
  518.    *-- get file handle
  519.    m->nHandle = fopen(m->cFileName)
  520.  
  521.    *-- store the file into the array
  522.    m->nX = 1
  523.    do while m->nX <= m->nLines
  524.       store fgets(m->nHandle,254) to &aTArray.[m->nX]
  525.       m->nX = m->nX + 1
  526.    enddo
  527.  
  528.    *-- close the file
  529.    m->nHandle = fClose(m->nHandle)
  530.  
  531. RETURN .T.
  532. *-- EoF: AAppend()
  533.  
  534. FUNCTION TextLine
  535. *-----------------------------------------------------------------------
  536. *-- Programmer..: Adam L. Menkes (Borland Technical Support)
  537. *-- Date........: 04/01/1992
  538. *-- Notes.......: Returns the number of lines of text in an ASCII Text 
  539. *--               File.  Taken from TechNotes, April, 1992
  540. *-- Written for.: dBASE IV, 1.5
  541. *-- Rev. History: 04/01/1992 -- Original Release
  542. *-- Calls.......: None
  543. *-- Called by...: Any
  544. *-- Usage.......: TextLine(<cTextFile>)
  545. *-- Example.....: ?TextLine("CONFIG.DB")
  546. *-- Returns.....: Number of lines
  547. *-- Parameters..: cTextFile = name of file
  548. *-----------------------------------------------------------------------
  549.  
  550.    parameter cTextFile
  551.    private nLines, nHandle, cTemp, nClose
  552.  
  553.    m->nLines = 0
  554.    if file(m->cTextFile)   && if it exists ...
  555.       m->nHandle = fopen(m->cTextFile,"R")
  556.       do while .not. feof(m->nHandle)
  557.          m->cTemp = fgets(m->nHandle,254)
  558.          m->nLines = m->nLines + 1
  559.       enddo
  560.       m->nClose = fclose(m->nHandle)
  561.    endif
  562.  
  563. RETURN m->nLines
  564. *-- EoF: TextLine()
  565.  
  566. FUNCTION ColorBrk
  567. *-----------------------------------------------------------------------
  568. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  569. *-- Date........: 03/24/1993
  570. *-- Notes.......: This routine is designed to be used with any of my 
  571. *--               functions and procedures that accept a memory variable
  572. *--               for color, and use a window. It's purpose is to break 
  573. *--               that color var into it's components (depending on 
  574. *--               which one the user wants) and return those 
  575. *--               components, so that they can then be used in SET COLOR
  576. *--               OF ... commands.
  577. *-- Written for.: dBASE IV, 1.1, 1.5 (written because of 1.5, but will 
  578. *--               work in 1.1)
  579. *-- Rev. History: 07/22/1992 - modified to handle memvars/color strings 
  580. *--                            that may have only two parts to them (no 
  581. *--                            <border>...), so that if the <nField> 
  582. *--                            parm is 2, we get a valid value.
  583. *--               03/24/1993 -- Lee Hite - Fixed to work correctly when 
  584. *--               <cColorVar> contains a single colorset (i.e., "b/w").
  585. *-- Calls.......: None
  586. *-- Called by...: Any
  587. *-- Usage.......: ColorBrk(<cColorVar>,<nField>)
  588. *-- Example.....: set color of normal to ColorBrk(cColor,1)
  589. *-- Returns.....: Either the field you asked for (1 thru 3) or null 
  590. *--               string ("").
  591. *-- Parameters..: cColorVar = Color variable to extract data from
  592. *--                           Assumes the form: 
  593. *--                                <main color>,<highlight>,<border>
  594. *--                            Where each part uses: 
  595. *--                                <foreground>/<background> format --
  596. *--                                i.e., rg+/gb,w+/b,rg+/gb
  597. *--               nField    = Field you want to extract
  598. *-----------------------------------------------------------------------
  599.  
  600.    parameters cColorVar, nField
  601.    private cReturn, cExtracted
  602.    
  603.    do case
  604.       case m->nField = 1
  605.          if at(",",m->cColorVar) > 0
  606.             m->cReturn = left(m->cColorVar,at(",",m->cColorVar)-1)
  607.          else
  608.             m->cReturn = m->cColorVar
  609.          endif
  610.       case m->nField = 2
  611.          m->cExtract = substr(m->cColorVar,at(",",m->cColorVar)+1)  
  612.                            && everything to the right of the comma
  613.          if at(",",m->cExtract) > 0
  614.             m->cReturn = left(m->cExtract,at(",",m->cExtract)-1)    
  615.                            && left of second ,
  616.          else
  617.             m->cReturn = m->cExtract
  618.          endif
  619.       case m->nField = 3
  620.          m->cExtract = substr(m->cColorVar,at(",",m->cColorVar)+1)
  621.          if at(",",m->cExtract) > 0
  622.             m->cReturn = substr(m->cExtract,at(",",m->cExtract)+1)
  623.          else
  624.             m->cReturn = ""
  625.          endif
  626.       otherwise
  627.          m->cReturn = ""
  628.    endcase
  629.  
  630. RETURN m->cReturn
  631. *-- EoF: ColorBrk()
  632.  
  633. PROCEDURE Shadow
  634. *-----------------------------------------------------------------------
  635. *-- Programmer..: Ashton-Tate
  636. *-- Date........: 01/27/1992
  637. *-- Notes.......: Creates a shadow for a window (taken from the dBASE IV
  638. *--               picklist functions)
  639. *-- Written for.: dBASE IV, 1.1
  640. *-- Rev. History: 05/23/1991 - original procedure.
  641. *--               12/14/1991 - Modified by Jim Magnant (TXAGGIE) - to 
  642. *--               check for columns exceeding 79, and temporarily change
  643. *--               last col. value (so routine doesn't "blow up").
  644. *--               01/27/1992 -- Modifiedy by Ken Mayer to check for 
  645. *--               bottom of screen, based on what Jim did above. No 
  646. *--               further than 23.
  647. *-- Calls.......: None
  648. *-- Called by...: Too many to list ...
  649. *-- Usage.......: do shadow with <nULRow>,<nULCol>,<nBRRow>,<nBRCol>
  650. *-- Example.....: save screen to sMain
  651. *--               activate screen
  652. *--               define window wError from 5,15 to 15,65 double color;
  653. *--                    rg+/r,rg+/r,rg+/r
  654. *--               do shadow with 5,15,15,65
  655. *--               activate window WError
  656. *--                && perform actions in window
  657. *--               release window WError
  658. *--               restore screen from sMain
  659. *--               release screen sMain
  660. *-- Returns.....: None
  661. *-- Parameters..: nULRow = Upper Left Row position
  662. *--               nULCol = Upper Left Column position (x,y)
  663. *--               nBRRow = Bottom Right Row position
  664. *--               nBRCol = Bottom Right Column position (x2,y2)
  665. *-----------------------------------------------------------------------
  666.  
  667.    parameters nULRow,nULCol,nBRRow,nBRCOL
  668.    private nTempRow,nTempCol,nIncRow,nIncCol
  669.  
  670.    m->nTempRow = iif(m->nBRRow+1>23,23,m->nBRRow+1)
  671.    m->nTempCol = iif(m->nBRCol+2>79,79,m->nBRCol+2)
  672.    m->nIncRow = 1
  673.    m->nIncCol = (m->nBRCol-m->nULCol) / (m->nBRRow-m->nULRow)
  674.    do while m->nTempRow <> m->nULRow .or. m->nTempCol <> m->nULCol+2
  675.       m->nRightCol = m->nBRCol
  676.       m->nBRCol = iif(m->nBRCol + 2 > 79,77,m->nBRCol)
  677.       nBotRow = m->nBRRow
  678.       m->nBRRow = iif(m->nBRRow + 1 > 23,22,m->nBRRow)
  679.       @ m->nTempRow,m->nTempCol fill to m->nBRRow+1,m->nBRCol+2 ;
  680.                                                       color n+/n
  681.       m->nBRCol = m->nRightCol
  682.       m->nBRRow = nBotRow
  683.       m->nTempRow = iif(m->nTempRow<>m->nULRow,m->nTempRow - ;
  684.                                              m->nIncRow,m->nTempRow)
  685.       m->nTempCol = iif(m->nTempCol<>m->nULCol+2,m->nTempCol -;
  686.                                              m->nIncCol,m->nTempCol)
  687.       m->nTempCol = iif(m->nTempCol<m->nULCol+2,m->nULCol+2,;
  688.                                              m->nTempCol)
  689.    enddo
  690.    
  691. RETURN
  692. *-- EoP: Shadow
  693.  
  694. *-----------------------------------------------------------------------
  695. *-- End of Program: LISTFILE.PRG
  696. *-----------------------------------------------------------------------
  697.